home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / hypercar / xfcn / spttool.cpt / Support Tools eXternals 1.2.5 / card_34727.txt < prev    next >
Text File  |  1990-11-13  |  12KB  |  318 lines
  1. -- card: 34727 from stack: in.5
  2. -- bmap block id: 9864
  3. -- flags: 0000
  4. -- background id: 3858
  5. -- name: FileType
  6. ----- HyperTalk script -----
  7. on HideObjects
  8.   hide cd btn "Try It!"
  9. end HideObjects
  10.  
  11. on ShowObjects
  12.   show cd btn "Try It!"
  13. end ShowObjects
  14.  
  15.  
  16. -- part 1 (button)
  17. -- low flags: 00
  18. -- high flags: A002
  19. -- rect: left=82 top=185 right=219 bottom=175
  20. -- title width / last selected line: 0
  21. -- icon id / first selected line: 0 / 0
  22. -- text alignment: 1
  23. -- font id: 0
  24. -- text size: 12
  25. -- style flags: 8192
  26. -- line height: 16
  27. -- part name: Try it!
  28. ----- HyperTalk script -----
  29. on mouseUp
  30.   global errGlobal
  31.   put FilePath("", "Choose a file please.") into fileName
  32.   if fileName = empty then exit mouseUp
  33.   put FileType(fileName, "nodialog:errGlobal") into fType
  34.   if errGlobal Γëá empty then
  35.     answer "Error: ΓÇ£" & errGlobal & "ΓÇ¥"
  36.     put empty into errGlobal
  37.   else
  38.     answer "The type string for ΓÇ£" & fileName & "ΓÇ¥ is ΓÇ£" & fType & "ΓÇ¥"
  39.   end if
  40. end mouseUp
  41.  
  42.  
  43.  
  44.  
  45. -- part contents for background part 38
  46. ----- text -----
  47. 20/50
  48.  
  49. -- part contents for background part 20
  50. ----- text -----
  51. FileType - An XFCN to return the File Type of a specified file
  52.  
  53. FileType(pathname, <"noDialog:"errorGlobal>)
  54.  
  55. This XFCN will return the four character File Type for the file specified by pathname.
  56.  
  57.  
  58. -- part contents for background part 42
  59. ----- text -----
  60. { FileType(pathname ┬½,"nodialog":errGlobal┬╗)              }
  61. { XFCN to return the creator for the file specified by      }
  62. { the path given in the first parameter.                        }
  63. {}
  64. {   Written by:      Anup Murarka         Eric Carlson        }
  65. {               ALINK:  SKEPTIC       ALINK:  cyNic               }
  66. {                                   CIS:  76004,3356}
  67. {}
  68. {               We are part of the Support Tools Development Group,     }
  69. {               Apple Computer, Inc.      }
  70. {}
  71. {               please DO NOT contack Mac DTS for support of this code!    }
  72. {}
  73. {               please DO contact the authors for support of this code!     }
  74. {}
  75. {               Send comments, bug reports, requests to any of the above   }
  76. {               E-mail addresses or to:}
  77. {}
  78. {                           (one of us)                  }
  79. {                           Apple Computer, Inc.          }
  80. {                           900 E. Hamilton, Ave.          }
  81. {                           Campbell, CA   95008      }
  82. {                           M/S 72-L                     }
  83. {}
  84. {   Copyright:   ┬⌐ 1989, 1990 by Apple Computer, Inc., all rights reserved.     }
  85. {}
  86. { written by    : Anup Murarka                                                                               }
  87. { AppleLink  : Skeptic                                                                                      }
  88. { modification history                                                                                        }
  89. {          Date              Initials                                    Comments                               }
  90. {          ----          ------          ------------------------------------------------------}
  91. {       8/16/89           akm         first written                                                                       }
  92. {       5/21/90           ec            removed upper case converion for A/UX compatibility.   }
  93. {                                           Changed version to 1.1.  Changed for LSP 3.0                       }
  94. {}
  95. unit FileType;
  96.  
  97. interface
  98.  
  99.     uses
  100.         HyperXCMD;
  101.  
  102.     procedure MAIN (paramPtr: XCmdPtr);
  103.  
  104. implementation
  105.  
  106.     procedure FileType (paramPtr: XCmdPtr);
  107.     FORWARD;
  108.  
  109.     procedure MAIN (paramPtr: XCmdPtr);
  110.     begin
  111.         FileType(paramPtr);
  112.     end;
  113.  
  114.     procedure reportToUser (paramPtr: XCmdPtr;
  115.                                     msgStr: str255);
  116. {}
  117. { report something back to the user.  }
  118. { the last parameter (optional) to an external may contain }
  119.  { "noDialog" or "noDialog:GlobalName".  GlobalName is the name }
  120.  { of a HyperTalk global variable into which error messages will be }
  121.  { placed.  we've decided to use this approach to avoid confusing }
  122. { an error message with a valid result being returned from an XFCN. }
  123. {}
  124.         var
  125.             tempStr: str255;
  126.     begin
  127. {check the last param to see if the user requested that}
  128. { we suppress the error dialog }
  129.         ZeroToPas(paramPtr, paramPtr^.params[paramPtr^.paramCount]^, tempStr);
  130.         UprString(tempStr, true);
  131.         if pos('NODIALOG', tempStr) = 0 then
  132.     { no special error handling specified, throw up a dialog and return the error message }
  133.             begin
  134.                 SendCardMessage(paramPtr, concat('answer "', msgStr, '"'));
  135.                 paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
  136.             end
  137.         else if (pos(':', tempStr) > 0) then
  138.     { requested global AND noDialog so we fill in the global and return empty }
  139.             begin
  140.                 tempStr := copy(tempStr, pos(':', tempStr) + 1, length(tempStr));
  141.                                                         { get the name of the HC global  to fill }
  142.                 SetGlobal(paramPtr, tempStr, PasToZero(paramPtr, msgStr));
  143.                                                         { and fill it }
  144.                 paramPtr^.returnValue := PasToZero(paramPtr, '');      { return empty }
  145.             end
  146.         else
  147.     { requested noDialog only so we return the error condition as the result }
  148.             paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
  149.     end;     { procedure }
  150.  
  151.     function AskedForHelp (paramPtr: XCmdPtr;
  152.                                     syntaxMsg: Str255;
  153.                                     copyrightMsg: Str255): boolean;
  154. {   check to see if the user sent a '?' or a '!' as }
  155. { the only parameter. if so we will respond with }
  156. { the calling syntax or the copyright/version info }
  157. { for this external }
  158. {}
  159.         var
  160.             firstStr: str255;
  161.     begin
  162.         askedForHelp := false;
  163.         if paramPtr^.paramCount = 1 then
  164.             begin
  165.                 ZeroToPas(paramPtr, paramPtr^.params[1]^, firstStr);
  166.                     { what is the first param? }
  167.                 if firstStr = '?' then
  168.                     begin
  169.                         reportToUser(paramPtr, syntaxMsg);
  170.                         askedForHelp := true
  171.                     end  { asked for help }
  172.                 else if firstStr = '!' then
  173.                     begin
  174.                         reportToUser(paramPtr, copyRightMsg);
  175.                         askedForHelp := true
  176.                     end;     { asked for copyright info }
  177.             end;     { one parameter passed }
  178.     end;     { function }
  179.  
  180.     function BitTest (AddressToCheck: ptr;
  181.                                     TotalBits: integer;
  182.                                     BitToTest: longint): boolean;
  183.     { function that allows caller to use std. 68000 bit notation instead of the Toolbox's reversed notation}
  184.     { example:  bit 0 (the least significant bit) in a byte is bit 7 in the Toolbox's notation}
  185.     begin
  186.         BitTest := BitTst(AddressToCheck, TotalBits - 1 - BitToTest);
  187.     end;
  188.  
  189.     function NumberToString (paramPtr: XCmdPtr;
  190.                                     num: LONGINT): Str255;
  191. { use the toolbox call rather than HC's }
  192.         var
  193.             tempStr: str255;
  194.     begin
  195.         NumToString(num, tempStr);
  196.         NumberToString := tempStr;
  197.     end;
  198.  
  199.     procedure reportResError (paramPtr: XCmdPtr;
  200.                                     errorNum: integer);
  201.         var
  202.             errMsg, tempName: str255;
  203.     begin
  204.         case errorNum of                   { what caused the problem? }
  205.             -0: 
  206.                 errMsg := 'no error.';
  207.             -36: 
  208.                 errMsg := 'I/O Error.';
  209.             -37: 
  210.                 errMsg := 'bad file name or volume name.';
  211.             -38: 
  212.                 errMsg := 'file not open.';
  213.             -39: 
  214.                 errMsg := 'that file has no resource fork.';
  215.             -42: 
  216.                 errMsg := 'too many files open.';
  217.             -43: 
  218.                 errMsg := 'file not found.';
  219.             -45, -54, -61: 
  220.                 errMsg := 'file locked.';
  221.             -47, -49: 
  222.                 errMsg := 'file is busy.';
  223.             -53: 
  224.                 errMsg := 'that volume is not on line.';
  225.             -108: 
  226.                 errMsg := 'not enough room in heap zone.';
  227.             -120: 
  228.                 errMsg := 'directory not found.';
  229.             -121: 
  230.                 errMsg := 'too many working directories open.';
  231.             -127: 
  232.                 errMsg := 'internal file system error.';
  233.             -192: 
  234.                 errMsg := 'resource not found.';
  235.             -193: 
  236.                 errMsg := 'file not found.';
  237.             otherwise
  238.                 errMsg := concat('unexpected error #', NumberToString(paramPtr, errorNum));
  239.         end;         { case }
  240.  
  241.         errMsg := concat('Sorry, ', errMsg);
  242.         reportToUser(paramPtr, errMsg);
  243.         { return the error message }
  244.     end;         { function }
  245.  
  246.     function getParams (paramPtr: XCmdPtr;
  247.                                     var PathToFile: str255): boolean;
  248.     { function to get the parameters and validate them.  Returns boolean}
  249.     { instructing the main procedure to continue if the parameters passed}
  250.     { are valid.  Also returns syntax messages if requested by the user.}
  251.         var
  252.             numParams: integer;
  253.             syntaxStr, copyrightStr: str255;
  254.  
  255.     begin
  256.         getParams := true;     {Initially, assume the parameters are valid.}
  257.         syntaxStr := 'FileType(pathname ┬½, ΓÇ£nodialogΓÇ¥:errGlobal┬╗)';
  258.         copyrightStr := '┬⌐ 1989,1990 Apple Computer, Inc., v.1.1, by Anup Murarka';
  259.  
  260.         {check that we have the proper number of parameters}
  261.         numParams := paramPtr^.paramCount;
  262.         if (numParams < 1) or (numParams > 2) then
  263.             begin
  264.                 getParams := false;
  265.                 reportToUser(paramPtr, syntaxStr);
  266.                 exit(getParams);
  267.             end;
  268.  
  269.         if AskedForHelp(paramPtr, syntaxStr, copyrightStr) then
  270.             begin
  271.                 getParams := false;
  272.                 exit(getParams);
  273.             end;
  274.  
  275.         { Get first parameter}
  276.         ZeroToPas(paramPtr, paramPtr^.Params[1]^, PathToFile);
  277.     end;     {GetParams}
  278.  
  279.     procedure FileType (paramPtr: XCmdPtr);
  280.         var
  281.             getParamsOK: boolean;
  282.             FileName: str255;
  283.             paramBlock: CInfoPBRec;
  284.             errorCode: OSerr;
  285.             charIndex: integer;
  286.     begin   { FileType}
  287.     { fetch and validate the passed parameters}
  288.         getParamsOK := getParams(paramPtr, FileName);
  289.         if not (getParamsOK) then
  290.             exit(FileType);
  291.  
  292.     { Initialize the parameter block.  Since we have the full pathname, no other field is really needed.}
  293.         zeroBytes(paramPtr, @paramBlock, sizeOf(paramBlock));
  294.         paramBlock.ioNamePtr := @FileName;
  295.  
  296.         errorCode := PBGetCatInfo(@paramBlock, FALSE);
  297.         if errorCode <> noErr then
  298.             begin
  299.                 reportResError(paramPtr, errorCode);
  300.                 exit(FileType);
  301.             end;
  302.  
  303.     { Make sure it is a file}
  304.         if BitTest(@paramBlock.ioFlAttrib, 8, 4) then
  305.             begin
  306.                 reportToUser(paramPtr, 'Sorry, directories do not have file types.');
  307.                 exit(FileType);
  308.             end;
  309.  
  310.     { Now initialize the return value.  Use FileName as a temp variable}
  311.         FileName := '1234';
  312.         for charIndex := 1 to 4 do
  313.             FileName[charIndex] := paramBlock.ioFlFndrInfo.fdType[charIndex];
  314.  
  315.         paramPtr^.returnValue := PasToZero(paramPtr, FileName);
  316.     end;
  317.  
  318. end.